home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / vpe_130 / delphi / vpedemo / unit1.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  45KB  |  1,418 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, VPENGINE, StdCtrls, Menus, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     File1: TMenuItem;
  13.     GenerateData1: TMenuItem;
  14.     DeleteReport1: TMenuItem;
  15.     N1: TMenuItem;
  16.     Exit1: TMenuItem;
  17.     Demos1: TMenuItem;
  18.     CapabilitiesPrecision1: TMenuItem;
  19.     SpeedTables1: TMenuItem;
  20.     Colors1: TMenuItem;
  21.     Report1: TMenuItem;
  22.     Help1: TMenuItem;
  23.     About1: TMenuItem;
  24.     PrintinBackground1: TMenuItem;
  25.     CloseColors1: TMenuItem;
  26.     Label1: TLabel;
  27.     procedure FormCreate(Sender: TObject);
  28.     procedure FormDestroy(Sender: TObject);
  29.     procedure Exit1Click(Sender: TObject);
  30.     procedure CapabilitiesPrecision1Click(Sender: TObject);
  31.     procedure GenerateData1Click(Sender: TObject);
  32.     procedure DeleteReport1Click(Sender: TObject);
  33.     procedure SpeedTables1Click(Sender: TObject);
  34.     procedure Colors1Click(Sender: TObject);
  35.     procedure Report1Click(Sender: TObject);
  36.     procedure FormResize(Sender: TObject);
  37.     procedure PrintinBackground1Click(Sender: TObject);
  38.     procedure CloseColors1Click(Sender: TObject);
  39.     procedure About1Click(Sender: TObject);
  40.   private
  41.     { Private declarations }
  42.     procedure AppOnMessage(var Msg: TMsg; var Handled: boolean);
  43.     procedure VPEHelp(var Msg: TMsg); message VPE_HELP;  {VPE sends this message to the form, not the application}
  44.     procedure WMKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN;
  45.   public
  46.     { Public declarations }
  47.     CanClose : byte;
  48.     DemoText : PChar;
  49.     PrecisionHDoc : longint;
  50.     PBackGndHDoc : longint;
  51.     ReportHDoc : longint;
  52.     ColorsHDoc : longint;
  53.     SpeedHDoc : longint;
  54.     procedure Precision(const Mode : integer);
  55.     procedure ReportTest;
  56.     procedure ColorTest;
  57.   end;
  58.  
  59. var
  60.   Form1: TForm1;
  61.  
  62. implementation
  63.  
  64. uses Unit2, Unit3;
  65.  
  66. {$R *.DFM}
  67. function pow(x:double; n:byte):double;
  68. var
  69.   m : byte;
  70.   f : double;
  71. begin
  72.   try
  73.     m := n;
  74.     case m of
  75.       0 : f := 1.0;
  76.       1 : f := x;
  77.       else f := x * pow(x, m - 1);
  78.     end; { case }
  79.     if (n < 0) then
  80.       Result := 1.0 / f
  81.     else
  82.       Result := f;
  83.   except
  84.       on EZeroDivide do
  85.         Result := 0;
  86.   end;
  87. end;
  88.  
  89. procedure MakeDemoText(ZString : PChar);
  90. begin
  91.   StrCopy(ZString, 'The moment of impact bursts through the silence and in a roar of sound, the');
  92.   StrCat(ZString, 'final second is prolonged in a world of echoes as if concrete and clay of');
  93.   StrCat(ZString, 'Broadway itself was reliving its memories.' + #10);
  94.   StrCat(ZString, 'The last great march past. Newsman stands limp as a whimper as audience and');
  95.   StrCat(ZString, 'eventare locked as one. Bing Crosby coos''You don''t have to feel pain');
  96.   StrCat(ZString, 'to sing the blues, you don''t have to holla - you don''t feel a thing in your');
  97.   StrCat(ZString, 'dollar collar.'' Martin Luther cries ''Everybody Sing!'' and rings the grand old');
  98.   StrCat(ZString, 'liberty bell. Leary, weary of his prison cell, walks on heaven, talks on hell.' + #10);
  99.   StrCat(ZString, 'Who needs Medicare and the 35c flat rate fare, when Fred Astaire and');
  100.   StrCat(ZString, 'Ginger Rogers are dancing through the air? From Broadway Melody stereotypes');
  101.   StrCat(ZString, 'the band returns to ''Stars and Stripes'' bringing a tear to the moonshiner,');
  102.   StrCat(ZString, 'who''s been pouring out his spirit from the illegal still. The pawn broker');
  103.   StrCat(ZString, 'clears the noisy till and clutches his lucky dollar bill.' + #10);
  104.   StrCat(ZString, 'Then the blackout.' + #10 + #10);
  105.   StrCat(ZString, '(Genesis, ''The Lamb lies down on Broadway'')');
  106. end;
  107.  
  108. {===Precision===}
  109. const
  110.   HEADLINE = 1;
  111.  
  112. {Page 1 of Precision demo}
  113. procedure page1(hdoc: longint);
  114. var
  115.   Page1Text : PChar;
  116.   y : integer;
  117. begin
  118.   Page1Text := StrAlloc(2048);
  119.   try
  120.     StrCopy(Page1Text, '[Center PenSize 3]This demo shows the capabilities and precision of VPE.'+#10);
  121.     StrCat(Page1Text, 'Print this page and compare not only the ');
  122.     StrCat(Page1Text, 'positions of the frames,'+#10+'but the positions of each letter that can be seen.'+#10);
  123.     StrCat(Page1Text, '(Switch the grid on.)'+#10);
  124.     StrCat(Page1Text, 'This is true WYSIWYG !!!'+#10+'(''What you see is what you get'')'+#10);
  125.     StrCat(Page1Text, 'Note, that the nearest result can be seen at a scaling of 1:1.'+#10);
  126.     StrCat(Page1Text, 'With every other scaling you get ''best results'' in comparison to execution speed.');
  127.     y := VpeWriteBox(hdoc, 575, 200, 1625, -1, Page1Text);
  128.  
  129.     StrCopy(Page1Text, '[''Arial'' FontSize 14 Left Bold Italic Underline PenSize 0]');
  130.     StrCat(Page1Text, 'RIGHT ALIGNED, 0.25 cm blue frame, light-blue backgr., red bold text, Arial 9pt');
  131.     y := VpeWriteBox(hdoc, 100, y + 75, 2000, -1, Page1Text);
  132.  
  133.     VpeStoreSet(hdoc, HEADLINE);
  134.  
  135.     VpeSelectFont(hdoc, 'Arial', 9);
  136.     VpeSetPen(hdoc, 25, PS_SOLID, COLOR_BLUE);
  137.     VpeSetTextColor(hdoc, COLOR_LTRED);
  138.     VpeSetFontAttr(hdoc, ALIGN_RIGHT, 1, 0, 0);
  139.     VpeSetTransparentMode(hdoc, 0);
  140.     VpeSetBkgColor(hdoc, COLOR_CYAN);
  141.     {// y+30 because frame = 0.25cm --> frame drawn around center of coordinates}
  142.     {// we also want a little gap between the headline and the frame}
  143.     y := VpeWriteBox(hdoc, 150, y + 30, 1850, -1, Form1.DemoText);
  144.     VpeSetTransparentMode(hdoc, 1);
  145.  
  146.     VpeUseSet(hdoc, HEADLINE);
  147.     y := VpeWrite(hdoc, 250, y + 75, 2000, -1, 'JUSTIFIED, no frame, Times New Roman 11pt');
  148.  
  149.     VpeSelectFont(hdoc, 'Times New Roman', 11);
  150.     VpeSetFontAttr(hdoc, ALIGN_JUSTIFIED, 0, 0, 0);
  151.     y := VpeWriteBox(hdoc, 250, y + 20, 1550, -1, Form1.DemoText);
  152.  
  153.     VpeUseSet(hdoc, HEADLINE);
  154.     y := VpeWriteBox(hdoc, 250, y + 75, 2000, -1, 'CENTERED, thin yellow frame, Times New Roman 11pt');
  155.  
  156.     VpeSelectFont(hdoc, 'Times New Roman', 11);
  157.     VpeSetFontAttr(hdoc, ALIGN_CENTER, 0, 0, 0);
  158.     VpeSetPen(hdoc, 5, PS_SOLID, COLOR_LTYELLOW);
  159.     y := VpeWriteBox(hdoc, 150, y + 20, 1850, -1, Form1.DemoText);
  160.   finally
  161.     StrDispose(Page1Text);
  162.   end;
  163. end;
  164.  
  165. {Page 2 of Precision demo}
  166. procedure Page2(hdoc : longint);
  167. const
  168.   xr : double = 6;
  169.   yr : double = 18;
  170.   index : integer = 0;
  171.   skip : integer = 0;
  172.   first : integer = 0;
  173.   xx : integer = 0;
  174.   oldy : integer = 0;
  175.   segments : integer = 0;
  176. type
  177.   TPointArray = array[0..0] of TPoint;
  178.   TPointPtr = ^TPointArray;
  179. var
  180.   y : integer;
  181.   x : double;
  182.   xstep : double;
  183.   s : array[0..159] of char;
  184.   p : longint;
  185.   points : TPointPtr;
  186. begin
  187.   VpePageBreak(hdoc);
  188.   VpeUseSet(hdoc, HEADLINE);
  189.   y := VpeWriteBox(hdoc, 200, 200, 2000, -1, 'An example of drawing (better to turn the grid off here):');
  190.   VpeSetPen(hdoc, 8, PS_SOLID, COLOR_BLACK);
  191.   VpeBox(hdoc, 200, 300, 1700, 1800);
  192.   VpeSetPen(hdoc, 3, PS_SOLID, COLOR_BLACK);
  193.  
  194.   xstep := xr / 750;
  195.  
  196.   {   // The following graph is created with VpeAddPolyPoint() }
  197.   x := -xr;
  198.   skip := 0;
  199.   VpeSetPen(hdoc, 2, PS_SOLID, COLOR_BLUE);
  200.   p := VpePolyLine(hdoc, 0, 1500);
  201.  
  202.   for xx := 200 to 1699 do
  203.   begin
  204.     y := trunc(1050 - (pow(x, 3) - 2*pow(x, 2) - 8*x) / ( yr / 750));
  205.     x := x+xstep;
  206.  
  207.     if (y < 300) then
  208.     begin
  209.        y := 300;
  210.        skip := 1;
  211.        continue;
  212.     end
  213.     else if (y > 1800) then
  214.     begin
  215.        y := 1800;
  216.        skip := 1;
  217.        continue;
  218.     end;
  219.  
  220.     if (skip = 1) then
  221.     begin
  222.        VpeAddPolyPoint(hdoc, p, -1, -1);
  223.        oldy := y;
  224.        skip := 2;
  225.     end
  226.     else
  227.     begin
  228.        if (skip = 2) then
  229.        begin
  230.           VpeAddPolyPoint(hdoc, p, xx-1, oldy);
  231.           skip := 0;
  232.        end;
  233.        VpeAddPolyPoint(hdoc, p, xx, y);
  234.        inc(segments);
  235.     end;
  236.   end;
  237.  
  238.   {   // The following graph is created directly with VpePolyLine() }
  239.  
  240.   {$R-} {Range checking off for dynamic array}
  241.   GetMem(points, 3 * 1500 * sizeof(TPoint));
  242.   try
  243.     x := -xr;
  244.     first := 1;
  245.     VpeSetPen(hdoc, 2, PS_SOLID, COLOR_LTRED);
  246.     index := 0;
  247.     for xx := 200 to 1699 do
  248.     begin
  249.       y := trunc(1050 - (3*pow(x, 2) - 4*x - 8) / ( yr / 750)